module Lib
  ( startApp,
  )
where

import Control.Lens ((^.))
import Control.Monad.Logger (logErrorN, logInfoN, runStderrLoggingT, runStdoutLoggingT)
import Data.Aeson (ToJSON (toJSON))
import Data.List.Extra (dropPrefix)
import Data.Maybe (fromJust)
import Data.Pool (defaultPoolConfig, newPool)
import Data.Text (pack, unpack)
import Database.Persist.Postgresql (createPostgresqlPool, liftSqlPersistMPool, runMigration)
import Database.PostgreSQL.Simple (close, connectPostgreSQL)
import Effectful (runEff)
import Effectful.FileSystem (runFileSystem)
import Effectful.Reader.Dynamic (runReader)
import Network.Wai (Application, Middleware)
import Network.Wai.Handler.Warp (run)
import Network.Wai.Middleware.Cors (CorsResourcePolicy (corsMethods, corsRequestHeaders), cors, simpleCorsResourcePolicy)
import Network.Wai.Middleware.RequestLogger (logStdout, logStdoutDev)
import Network.Wai.Middleware.Static (Policy (tryPolicy), hasPrefix, policy, staticPolicy, (>->))
import Protolude hiding (runReader)
import Vote.Api (routes, allRoutes)
import Vote.Internal.App (AppEnv (..))
import Vote.Internal.Config (Config, configConn, configDir, configEnv, configSite, connPostgreSQL, dirStatic, loadConfig, pathStatic, sitePath, sitePort)
import Vote.Internal.Effect (runLoggingIO)
import Vote.Internal.Model (migrateAll)
import WebGear.Server (toApplication, transform)

app :: AppEnv -> Application
app env = toApplication . transform (runEff . runReader env . runFileSystem . runLoggingIO) $ allRoutes

startApp :: IO ()
startApp = do
  let logPrefix = "[START APP]"
  runResult <- runStdoutLoggingT . runExceptT $ do
    logInfoN . pack $ ">>> load config"
    mConfig <- liftIO loadConfig
    when (isNothing mConfig) . logInfoN . pack $ "cannot load config, use default"
    let config = fromJust mConfig
    logInfoN . pack $ ">>> config -- " <> show (toJSON config)
    let (midStatic, staticPath) = midStaticFunc config
    logInfoN . pack $ ">>> find static files in -- " <> staticPath
    let logFunc = case config ^. configEnv of
          "dev" -> logStdoutDev
          _ -> logStdout
    let connStr = config ^. configConn . connPostgreSQL
    logInfoN . pack $ ">>> create connection pool of database -- " <> unpack connStr
    pool <- liftIO . newPool $ defaultPoolConfig (connectPostgreSQL $ encodeUtf8 connStr) close 60 20
    logInfoN . pack $ ">>> database migration"
    pool' <- lift $ createPostgresqlPool (encodeUtf8 connStr) 20
    liftSqlPersistMPool (runMigration migrateAll) pool'
    let port = config ^. configSite . sitePort
    logInfoN . pack $ ">>> appMain started on port :" <> show port
    let env = AppEnv config pool
    liftIO . run port . logFunc . midCors . midStatic $ app env
  case runResult of
    Left e -> runStderrLoggingT $ logErrorN . pack $ logPrefix <> show (e :: Text)
    _ -> return ()

midCors :: Middleware
midCors = cors . const $ Just appCorsResourcePolicy
  where
    appCorsResourcePolicy =
      simpleCorsResourcePolicy
        { corsMethods = ["OPTIONS", "GET", "POST"],
          corsRequestHeaders = ["Authorization", "Content-Type"]
        }

midStaticFunc :: Config -> (Middleware, FilePath)
midStaticFunc config = (staticPolicy tPolicy, staticPath)
  where
    staticPrefix = unpack $ config ^. configSite . sitePath . pathStatic
    staticDir = unpack $ config ^. configDir . dirStatic
    tPolicy = hasPrefix staticPrefix >-> policy (Just . (staticDir <>) . dropPrefix staticPrefix)
    staticPath = fromMaybe "" $ tryPolicy tPolicy staticPrefix
